load packages
library(tidyverse)
library(knitr)
define variables
# paths
outputDir = '/Volumes/psych-cog/dsnlab/auto-motion-output/'
# variables
study = "FP"
load data
# global intensity file created using calculate_global_intensities.R
trash = read.csv(paste0(outputDir,study,'_autoTrash.csv'))
# manually coded file created using manually_coded.R
manual = read.csv(paste0(outputDir,study,'_manuallyCoded.csv'))
# afni 3dToutCount outlier created using merge_outcount.R
outcount = read.csv(paste0(outputDir,study,'_outcount.csv')) %>%
filter(poly == "p2") %>%
mutate(trashOut = ifelse(outliers > .075, 1, 0))
compare to manual data
# filter trash dataframe and join with filteredMotion
joined = trash %>%
left_join(., manual, by = c("subjectID","run","volume")) %>%
left_join(., outcount, by = c("subjectID","run","volume")) %>%
select(subjectID, run, volume, volMean, volSD, trashDiff, trashOut, trash) %>%
#select(subjectID, run, volume, volMean, volSD, trashDiff, trash) %>%
mutate(auto = ifelse(trashDiff == 1 & trash == 1, 2,
ifelse(trashDiff == 1 & trash == 0, 3, trash)),
outcount = ifelse(trashOut == 1 & trash == 1, 2,
ifelse(trashOut == 1 & trash == 0, 3, trash)))
joined.plot = joined %>%
gather(compare, code, -c(subjectID, run, volume, volMean, volSD, trashDiff, trashOut, trash))
#gather(compare, code, -c(subjectID, run, volume, volMean, volSD, trashDiff, trash))
# check false negatives
falseNeg.auto = joined %>% filter(trashDiff == 0 & trash == 1)
falseNeg.outcount = joined %>% filter(trashOut == 0 & trash == 1)
# check false positives
falsePos.auto = joined %>% filter(trashDiff == 1 & trash == 0)
falsePos.outcount = joined %>% filter(trashOut == 1 & trash == 0)
# check hits
hits.auto = joined %>% filter(trashDiff == 1 & trash == 1)
hits.outcount = joined %>% filter(trashOut == 1 & trash == 1)
summarize results
print group-level results
table = data.frame(falseNeg = c(length(falseNeg.auto$trash),length(falseNeg.outcount$trash)),
falsePos = c(length(falsePos.auto$trash),length(falsePos.outcount$trash)),
hits = c(length(hits.auto$trash),length(hits.outcount$trash)))
row.names(table)=c("auto","outcount")
kable(table,format = "pandoc")
| auto |
186 |
129 |
328 |
| outcount |
313 |
104 |
203 |
# table = data.frame(falseNeg = c(length(falseNeg.auto$trash)),
# falsePos = c(length(falsePos.auto$trash)),
# hits = c(length(hits.auto$trash)))
# row.names(table)=c("auto")
# kable(table,format = "pandoc")
summarize by participants
nVol = joined %>% group_by(subjectID) %>% summarize(nVol = length(volume))
summaryPos = falsePos.auto %>% group_by(subjectID) %>% summarize(falsePos = sum(trashDiff, na.rm=T))
summaryNeg = falseNeg.auto %>% group_by(subjectID) %>% summarize(falseNeg = sum(trash, na.rm=T))
summaryPosNeg = nVol %>%
full_join(., summaryPos, by = "subjectID") %>%
full_join(., summaryNeg, by = "subjectID") %>%
mutate(falseNeg = ifelse(is.na(falseNeg), 0, falseNeg),
falsePos = ifelse(is.na(falsePos), 0, falsePos),
totalErrors = falsePos + falseNeg,
percentErrors = (totalErrors/nVol)*100)
print subject-level results
joined %>% group_by(subjectID) %>%
summarise(trashManual = sum(trash, na.rm = T),
trashAuto = sum(trashDiff, na.rm = T)) %>%
full_join(., summaryPosNeg, by = "subjectID") %>%
select(-nVol) %>%
arrange(trashManual) %>%
kable(format = "pandoc", digits = 1)
| FP010 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| FP016 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| FP019 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| FP022 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| FP025 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| FP028 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| FP029 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| FP021 |
1 |
0 |
0 |
1 |
1 |
0.1 |
| FP007 |
3 |
7 |
4 |
0 |
4 |
0.6 |
| FP008 |
3 |
0 |
0 |
3 |
3 |
0.4 |
| FP009 |
3 |
0 |
0 |
3 |
3 |
0.4 |
| FP014 |
3 |
0 |
0 |
3 |
3 |
0.4 |
| FP024 |
3 |
4 |
3 |
2 |
5 |
0.7 |
| FP020 |
4 |
9 |
7 |
2 |
9 |
1.3 |
| FP031 |
4 |
3 |
3 |
4 |
7 |
1.0 |
| FP002 |
6 |
6 |
3 |
3 |
6 |
0.9 |
| FP013 |
6 |
0 |
0 |
6 |
6 |
0.9 |
| FP026 |
6 |
7 |
1 |
0 |
1 |
0.1 |
| FP035 |
6 |
4 |
2 |
4 |
6 |
0.9 |
| FP004 |
7 |
5 |
3 |
5 |
8 |
1.1 |
| FP027 |
7 |
4 |
1 |
3 |
4 |
0.6 |
| FP015 |
10 |
14 |
6 |
2 |
8 |
1.1 |
| FP030 |
12 |
7 |
0 |
5 |
5 |
1.0 |
| FP005 |
14 |
17 |
8 |
5 |
13 |
1.9 |
| FP006 |
14 |
12 |
6 |
8 |
14 |
2.0 |
| FP032 |
14 |
7 |
3 |
10 |
13 |
1.9 |
| FP023 |
17 |
8 |
5 |
14 |
19 |
2.7 |
| FP001 |
24 |
32 |
10 |
2 |
12 |
1.7 |
| FP018 |
37 |
32 |
12 |
17 |
29 |
4.2 |
| FP012 |
40 |
28 |
5 |
17 |
22 |
3.2 |
| FP003 |
55 |
46 |
7 |
16 |
23 |
3.3 |
| FP011 |
74 |
59 |
16 |
31 |
47 |
6.8 |
| FP034 |
143 |
146 |
24 |
20 |
44 |
6.3 |
# visualize for each subject subject
joined.plot = joined.plot %>% mutate(code = as.factor(code)) %>%
select(subjectID, run, volume, volMean, volSD, compare, code) %>%
gather(measure, value, -c(subjectID, run, compare, volume, code))
nada = joined.plot %>% group_by(subjectID) %>%
do({
plot = ggplot(., aes(volume, value)) +
geom_point(aes(color = code)) +
geom_line() +
facet_grid(measure + compare ~ run, scales= "free") +
scale_colour_discrete(drop = FALSE, labels=c("not trash", "false neg", "hit", "false pos")) +
labs(title = .$subjectID[[1]])
print(plot)
#ggsave(plot, file=paste0(outputDir,'plots/',.$subjectID[[1]],'.png'), width = 12)
data.frame()
})












